home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1997: The Complete Utilities Toolkit / macworld-complete-utilities-1997.iso / Programming / Little Smalltalk v3.1.5 / Smalltalk Source / inspector.st < prev    next >
Encoding:
Text File  |  1995-07-02  |  11.6 KB  |  503 lines  |  [TEXT/KAHL]
  1. * ***
  2. * Methods for an object inspector
  3. *
  4. * Julian Barkway (c) October 1994. All rights reserved. 
  5. *
  6. * v3.1.3 - Initial release.
  7. * v3.1.5 - Inspectors completely re-designed to reflect improvements in the basic protocol
  8. *          for Pane and SelectListPane. Protocol for ListPane absorbed into SelectListPane.
  9. *
  10. * ***
  11. Class InspectorView             Object        listPane editPane nameList theObject
  12. Class   ObjectInspector         InspectorView 
  13. Class   ClassHierarchyInspector InspectorView selectedClass
  14. Class   CollectionInspector     InspectorView
  15. Class       ArrayInspector         CollectionInspector
  16.  
  17. Class InspectorListPane            SelectListPane
  18. Class     ObjectInspectorListPane    InspectorListPane
  19. Class     CollInspectorListPane    InspectorListPane
  20. Class         ArrayInspectorListPane    CollInspectorListPane
  21.  
  22. Class InspectorEditPane            TextPane
  23. Class     ObjectInspectorEditPane    InspectorEditPane
  24. Class     CHInspectorEditPane        InspectorEditPane
  25. Class     CollInspectorEditPane    InspectorEditPane
  26.  
  27. Methods Object 'inspecting'
  28.     inspect 
  29.         ObjectInspector new; openOn: self
  30. ]
  31.  
  32. Methods Class 'inspecting'
  33.     inspect 
  34.         ClassHierarchyInspector new; openOn: self
  35. ]
  36.  
  37. Methods Array 'modifying'
  38.     removeValues: aConditionBlock
  39.     | list |
  40.         list <- List new.
  41.         self do: [ :x |
  42.             (aConditionBlock value: x ) ifFalse: [
  43.                 list addLast: x
  44.             ]
  45.         ].
  46.         self become: (list asArray)
  47. ]
  48.  
  49. Methods Class 'modifying'
  50.     addInstanceVariable: aSymbol
  51.     | s |
  52.         variables isNil ifTrue: [
  53.             variables <- Array new: 0
  54.         ].
  55.         s <- variables select: [ :i | aSymbol = i ]. 
  56.         (s size > 0) ifTrue: [
  57.             ^ true
  58.         ]
  59.         ifFalse: [        
  60.             variables <- variables grow: aSymbol.
  61.             ^ false
  62.         ]
  63. |
  64.     removeInstanceVariable: aSymbol
  65.     | s |
  66.         s <- variables select: [ :i | aSymbol = i ]. 
  67.         (s size = 0) ifTrue: [
  68.             ^ true
  69.         ]
  70.         ifFalse: [
  71.             j <- (variables size - 1).
  72.             (j = 0) ifTrue: [
  73.                 variables <- nil
  74.             ]
  75.             ifFalse: [
  76.                 variables removeValues: [ :x | aSymbol = x ]
  77.             ].
  78.             ^ false
  79.         ]
  80. ]
  81.  
  82. Methods IndexedCollection 'inspecting'
  83.     inspect 
  84.         CollectionInspector new; openOn: self
  85. ]
  86.  
  87. Methods Array 'inspecting'
  88.     inspect 
  89.         ArrayInspector new; openOn: self
  90. ]
  91.  
  92. Methods InspectorListPane
  93.     selectItem: aPoint
  94.         self withSelectedItemSend: #showValue: to: (parent editPane)
  95. |
  96.     createPopUpMenu
  97.         ^ nil
  98. |
  99.     editSelection: aSelector
  100.         self withSelectedItemSend: aSelector to: (parent editPane)
  101. |
  102.     clearEditPane: dummy
  103.         (parent editPane) cancel
  104. ]
  105.  
  106. Methods InspectorEditPane
  107.     createPopUpMenu
  108.     " Overridden by sub-classes "
  109.         ^ nil
  110. |
  111.     showValue: aValue
  112.     " Overridden by sub-classes "
  113.         ^ nil
  114. |
  115.     changeValue
  116.         (parent listPane) editSelection: #changeValue:
  117. |
  118.     addValue
  119.         (parent listPane) editSelection: #addValue:
  120. |
  121.     removeValue
  122.         (parent listPane) editSelection: #removeValue:
  123. |
  124.     changeValue: aValue
  125.     " Overridden by sub-classes "
  126.         ^ nil
  127. |
  128.     addValue: aValue
  129.     " Overridden by sub-classes "
  130.         ^ nil
  131. |
  132.     removeValue: aValue
  133.     " Overridden by sub-classes "
  134.         ^ nil
  135. |
  136.     cancel
  137.         self clearAllText.
  138.         pMenu disableItem: 1; disableItem: 2
  139. ]
  140.  
  141. Methods InspectorView 'all'
  142.     openOn: anObject
  143.         theObject <- anObject.
  144.         self createPanes.
  145.         self initialisePanesIn: (self makeWindow: (self makeTitle)).
  146.         self refreshListPane: theObject.
  147. |    
  148.     makeWindow: aTitle
  149.     | maxW maxH posX posY centreScreen origin |
  150.         maxW <- (smalltalk getMaxScreenArea) right.
  151.         maxH <- (smalltalk getMaxScreenArea) bottom.
  152.         centreScreen <- (0@0).
  153.         origin       <- (0@0).
  154.         centreScreen x: ((maxW / 2) truncated).
  155.         centreScreen y: ((maxH / 2) truncated).
  156.         origin <- centreScreen - (170@200).
  157.         maxW <- 340 min: ((origin x) + (maxW - 70)).
  158.         maxH <- 200 min: ((origin y) + (maxH - 70)).
  159.         ^ Window new; 
  160.             title: aTitle;
  161.             openAt: origin withSize: (maxW@maxH).
  162. |
  163.     createPanes
  164.     " Overridden by sub-classes "
  165.         ^ nil
  166. |
  167.     listPane
  168.         ^ listPane
  169. |
  170.     editPane
  171.         ^ editPane
  172. |
  173.     initialisePanesIn: aWindow 
  174.     | ww wh ph pw |
  175.         ww <- (aWindow size) x.
  176.         wh <- (aWindow size) y.
  177.         pw <- (ww / 2) truncated.
  178.         listPane openOn: (self createListFrom: theObject)
  179.                  in: aWindow 
  180.                  withSizeFrom: (-1 @ -1) to: (pw @ (wh + 1)).
  181.         listPane font: 'geneva'; fontSize: 9; typeFace: 2;
  182.                  parent: self;
  183.                  button1Action: #clearEditPane:;
  184.                  button1DoubleClick: #selectItem:.
  185.         editPane boundsFrom: ((pw - 1) @ -1) to: ((ww + 1) @ (wh + 1));
  186.                  attachTo: aWindow withSizing: (1 @ 1);
  187.                  font: 'monaco'; fontSize: 9;
  188.                  parent: self.
  189.         listPane owner: listPane.
  190.         editPane owner: editPane.
  191.         self overrideDefaultPaneSettings.
  192. |
  193.     overrideDefaultPaneSettings
  194.     " Overridden by sub-classes "
  195.          ^ nil
  196. |
  197.     createListFrom: theInspectedObject
  198.     " Overridden by sub-classes "
  199.         ^ nil
  200. |
  201.     refreshListPane: theInspectedObject
  202.         listPane collection: (self createListFrom: theInspectedObject); setText
  203. |
  204.     makeTitle
  205.     " Overridden by sub-classes "
  206.         ^ nil
  207. |
  208.     theObject
  209.         ^ theObject
  210. ]
  211.  
  212. Methods ObjectInspectorListPane
  213.     createPopUpMenu
  214.         pMenu <- PopUpMenu new; owner: self; create.
  215.         pMenu addItem: 'Inspect'                 action: #inspectItem;
  216.               addItem: 'Inspect Class Hierarchy' action: #inspectClassHierarchy
  217. |
  218.     inspectItem
  219.         self evaluateForSelectedItem: [ :valueArray |
  220.             (valueArray at: 1) inspect
  221.         ]
  222. |
  223.     inspectClassHierarchy
  224.         parent inspectClassHierarchy
  225. ]
  226.  
  227. Methods ObjectInspectorEditPane
  228.     createPopUpMenu
  229.         pMenu <- PopUpMenu new; owner: self; create.
  230.         pMenu addItem: 'Accept' action: #changeValue;
  231.               addItem: 'Cancel' action: #cancel.
  232. |
  233.     showValue: aValue
  234.         (aValue notNil) ifTrue: [
  235.             self clearAllText; print: ((aValue at: 1) printString).
  236.             pMenu enableItem: 1; enableItem: 2
  237.         ]
  238.         ifFalse: [
  239.             pMenu disableItem: 1; disableItem: 2
  240.         ]
  241. |
  242.     changeValue: valueArray
  243.     | s |
  244.           (valueArray notNil) ifTrue: [
  245.             inspectorTemp001 <- theObject.
  246.             s <- 'inspectorTemp001 basicAt: ' , 
  247.                  (valueArray at: 2) printString , 
  248.                  ' put: ' , (self text).
  249.             [
  250.             (s execute) notNil ifTrue: [
  251.                 valueArray 
  252.                     at: 1  
  253.                     put: (inspectorTemp001 basicAt: (valueArray at: 2))
  254.             ]
  255.             ] fork
  256.         ]
  257. ]
  258.  
  259. Methods ObjectInspector 'all'
  260.     createPanes
  261.         listPane <- ObjectInspectorListPane new.
  262.         editPane <- ObjectInspectorEditPane new.
  263. |
  264.     makeTitle
  265.         ^ 'Instance of: ' , ((theObject class) printString).
  266. |
  267.     createListFrom: anObject
  268.     | varNames t j a |
  269.         nameList  <- List new.
  270.         j <- anObject basicSize.
  271.         t <- anObject class.
  272.         [t notNil] whileTrue: [
  273.             varNames <- t variables.
  274.             (varNames notNil) ifTrue: [
  275.                 varNames reverseDo: [:varName |
  276.                     a <- Array new: 2; at: 1 put: (anObject basicAt: j); at: 2 put: j.
  277.                     nameList addFirstLink: (Link new;
  278.                                             value: a;
  279.                                             key: (varName asString)).
  280.                     j <- j - 1
  281.                 ]
  282.             ].
  283.             nameList addFirstLink: (Link new; value: nil; 
  284.                                     key: ('=== ' , (t printString) , ' ===') ).
  285.             t <- t superClass
  286.         ].
  287.         ^ nameList 
  288. |
  289.     inspectClassHierarchy
  290.         (theObject class) inspect
  291. ]
  292.  
  293. Methods CHInspectorEditPane
  294.     createPopUpMenu
  295.         pMenu <- PopUpMenu new; owner: self; create.
  296.         pMenu addItem: 'Add Variables'    action: #addVariables;
  297.               addItem: 'Remove Variables' action: #removeVariables;
  298.               addItem: 'Cancel'           action: #cancel.
  299. |
  300.     showValue: aClass 
  301.     | v |
  302.         v <- aClass variables.
  303.         self clearAllText.
  304.         (v isNil) ifTrue: [
  305.             self print: '<No instance variables>'.
  306.             pMenu enableItem: 1; disableItem: 2; enableItem: 3
  307.         ]
  308.         ifFalse: [
  309.             v do: [:c | self print: (c asString) , newLine ].
  310.             pMenu enableItem: 1; enableItem: 2; enableItem: 3
  311.         ].
  312.         selectedClass <- aClass
  313. |
  314.     addVariables | a |
  315.         a <-  (self text) words: [:x | x isAlphaNumeric ].
  316.         a do: [ :x | selectedClass addInstanceVariable: (x asSymbol) ].
  317.         self showValue: selectedClass
  318. |
  319.     removeVariables | a r |
  320.         a <- (self selectedText) words: [:x | x isAlphaNumeric ].
  321.         r <- smalltalk inquire: 'Please confirm removal of ', 
  322.                                 (a size) asString, ' variables'.
  323.         (r isNil) ifFalse: [
  324.             r ifTrue: [
  325.                 a do: [ :x | selectedClass removeInstanceVariable: (x asSymbol) ]
  326.             ]
  327.         ].
  328.         self showValue: selectedClass
  329. |
  330.     changeValue: valueArray
  331.     | s |
  332.           (valueArray notNil) ifTrue: [
  333.             inspectorTemp001 <- theObject.
  334.             s <- 'inspectorTemp001 basicAt: ' , 
  335.             (valueArray at: 2) printString , 
  336.             ' put: ' , ((parent editPane) text).
  337.             [
  338.             (s execute) notNil ifTrue: [
  339.                 valueArray 
  340.                     at: 1  
  341.                     put: (inspectorTemp001 basicAt: (valueArray at: 2))
  342.             ]
  343.             ] fork
  344.         ]
  345. ]
  346.  
  347. Methods ClassHierarchyInspector 'all'
  348.     createPanes
  349.         listPane <- ObjectInspectorListPane new.
  350.         editPane <- CHInspectorEditPane new.
  351. |
  352.     overrideDefaultPaneSettings
  353.         listPane button2Action: nil.
  354. |
  355.     makeTitle
  356.         ^ 'Class: ' , (theObject printString).
  357. |
  358.     createListFrom: aClass
  359.     | classList dots |
  360.         classList <- List new.
  361.         aClass upSuperclassChain: [:c |
  362.             classList addFirstLink: (Link new; 
  363.                                      value: c; 
  364.                                      key:  (c printString) )
  365.         ].
  366.         dots <- ''.
  367.         classList newDo: [ :lk |
  368.             lk key: (dots , (lk key)). 
  369.             dots <- (dots , '..')
  370.         ].
  371.         ^ classList
  372. ]
  373.  
  374. Methods CollInspectorListPane
  375.     createPopUpMenu
  376.         pMenu <- PopUpMenu new; owner: self; create.
  377.         pMenu addItem: 'Inspect'    action: #inspectItem;
  378.               addItem: 'Add Key'    action: #addKey;
  379.               addItem: 'Remove Key' action: #removeKey
  380. |
  381.     addKey
  382.     | ky |
  383.         ky <- smalltalk getPrompt: 'Enter a key:'.
  384.         (ky ~= '') ifTrue: [
  385.             [    
  386.             (parent executeAnAt: ky withPut: 'nil') notNil 
  387.             ifTrue: [
  388.                 parent refreshListPane
  389.             ]    
  390.             ] fork
  391.         ] 
  392. |
  393.     removeKey
  394.     | r |
  395.         self withSelectedItemSend: #removeKey: to: self
  396. |
  397.     removeKey: valueArray
  398.     | r |
  399.           (valueArray notNil) ifTrue: [
  400.             r <- smalltalk inquire: ('Please confirm removal of item ', 
  401.                                     ((valueArray at: 2) asString) ).
  402.             (r isNil) ifFalse: [
  403.                 r ifTrue: [
  404.                     (parent theObject) removeKey: (valueArray at: 2).
  405.                     parent refreshListPane.
  406.                      (parent editPane) cancel
  407.                 ]
  408.             ]
  409.         ]
  410. |
  411.     inspectItem
  412.         self evaluateForSelectedItem: [ :valueArray |
  413.             (valueArray at: 1) inspect
  414.         ]
  415. ]
  416.  
  417. Methods CollInspectorEditPane
  418.     createPopUpMenu
  419.         pMenu <- PopUpMenu new; owner: self; create.
  420.         pMenu addItem: 'Accept' action: #changeValue;
  421.               addItem: 'Cancel' action: #cancel.
  422. |
  423.     showValue: aValue
  424.         aValue notNil ifTrue: [
  425.             self clearAllText;
  426.                  print: ((aValue at:1) printString).
  427.             pMenu enableItem: 1; enableItem: 2
  428.         ]
  429.         ifFalse: [
  430.             pMenu disableItem: 1; disableItem: 2
  431.         ]
  432. |
  433.     changeValue: valueArray
  434.           (valueArray notNil) ifTrue: [
  435.               [
  436.             (parent executeAnAt: ((valueArray at: 2) printString) 
  437.                 withPut: ((parent editPane) text))
  438.             notNil ifTrue: [
  439.                 parent refreshListPane
  440.             ]
  441.             ] fork
  442.         ]
  443. ]
  444.  
  445. Methods CollectionInspector 'all'
  446.     createPanes
  447.         listPane <- CollInspectorListPane new.
  448.         editPane <- CollInspectorEditPane new.
  449. |
  450.     makeTitle
  451.         ^ 'Collection: ' , (theObject class printString).
  452. |
  453.     createListFrom: aCollection 
  454.     | theList a l |
  455.         theList <- List new.
  456.         aCollection binaryDo: [:k :v | 
  457.             l <- Link new.
  458.             a <- Array new: 3; at: 1 put: v; at: 2 put: k; at: 3 put: l. 
  459.             l value: a; key: ((k printString) , ' -> ' , (v printString)).
  460.             theList addLastLink: l 
  461.         ].
  462.         ^ theList
  463. |
  464.     executeAnAt: atText withPut: putText
  465.     | s | 
  466.         inspectorTemp001 <- theObject.
  467.         s <- 'inspectorTemp001 at: ', atText, ' put: ', putText.
  468.         ^ (s execute)
  469. |
  470.     refreshListPane
  471.         self refreshListPane: theObject
  472. ]
  473.  
  474. Methods ArrayInspectorListPane 'all'
  475.     addKey
  476.         parent addKey
  477. |
  478.     removeKey: valueArray
  479.           (valueArray notNil) ifTrue: [
  480.             r <- smalltalk inquire: ('Please confirm removal of item ', 
  481.                                     ((valueArray at: 2) asString) ).
  482.             (r isNil) ifFalse: [
  483.                 r ifTrue: [
  484.                     (parent theObject) removeValues: [ :y | y = (valueArray at: 1) ].
  485.                     parent refreshListPane.
  486.                      (parent editPane) cancel
  487.                 ]
  488.             ]
  489.         ]
  490. ]
  491.  
  492. Methods ArrayInspector 'all'
  493.     createPanes
  494.         listPane <- ArrayInspectorListPane new.
  495.         editPane <- CollInspectorEditPane new.
  496. |
  497.     makeTitle
  498.         ^ 'Array: ' , (theObject class printString).
  499. |
  500.     addKey
  501.         theObject <- (theObject grow: nil).
  502.         self refreshListPane: theObject
  503. ]